home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Languguage OS 2
/
Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO
/
language
/
embedded
/
mcu
/
float09.arc
/
PROCS.SA
< prev
next >
Wrap
Text File
|
1987-03-04
|
8KB
|
301 lines
*
NAM PROCS
*
* LINKING LOADER DEFINITIONS
*
XDEF TFRACT,LNORM,SNORM,PREC,SIZE,SIZTAB,ENORM
*
* REVISION HISTORY:
*
* DATE PROGRAMMER REASON
*
* 28.MAY.80 G. STEVENS ORIGINAL
* 06.JUN.80 G. STEVENS FIX TFRACT
* 10.JUL.80 J. BONEY CHANGE TFRACT,SNORM
* 15.JUL.80 J. BONEY MAKE ENORM,SNORM & LNORM
* USE MUTUAL CODE.
* 19.AUG.80 G. STEVENS LNORM SETS TYPE PROPERLY
* 20.AUG.80 J. BONEY SPEED UP TFRACT
* 08.0CT.80 G. STEVENS CORRECT STACK OFFSET IN ENORM
* 09.OCT.80 G. STEVENS CORRECT ADDR. MODE IN TFRACT
*
PAGE
*
******************************************************
*
* G L O B A L P R O C E D U R E S
*
********************************************************
*
*
* THESE PROCEDURES ARE USED BY ALL MODULES AND
* HENCE ARE GLOBAL.
*
* IF THESE PROCEDURES NEED SUB-PROCEDURES, THEY ARE
* INCLUDED HERE. IF THE SUB-PROCEDURES ARE
* GENERAL PURPOSE, THEY ARE CONSIDERED PROCEDURES
* IN THEIR OWN RIGHT
*
* IF PROCEDURES ARE ONLY USED LOCALLY BY A MODULE
* THEY ARE NOT INCLUDED HERE. THEY ARE
* IN THE MODULE THAT USES THEM
*
*
*
******************************************************
*
*
*************
*
* TFRACT - TEST FRACTION FOR ZERO
* AND SETS THE Z BIT IF THE RESULT IS ZERO
*
* ENTRY:
* X = POINTER TO ARGUMENT ON STACK FRAME
*
* EXIT:
* D = DESTROYED
* Z = 1 IF ALL FRACTION BITS ARE ZERO
*
***************
*
TFRACT EQU *
LDD FRACT,X TEST FOR ZERO 2 BYTES AT A TIME
BNE TFOUT
LDD FRACT+2,X
BNE TFOUT EXIT AS SOON AS A NON ZERO WORD OCCURS
LDD FRACT+4,X
BNE TFOUT
LDD FRACT+6,X
BNE TFOUT
LDA FRACT+8,X CHECK LAST BYTE
TFOUT EQU *
RTS EXIT WITH Z
*
PAGE
*
******************************************************
*
* LNORM,SNORM - NORMALIZE A NUMBER
* THAT IS IN INTERNAL FORM
*
* ON ENTRY: X POINTS TO THE ARGUMENT ON THE STACK FRAME
*
* ON EXIT: THE NUMBER POINTED TO BY X IS NORMALIZED
* Z IS SET IF FRACTION WAS ZERO. ALSO THE
* NUMBER IS SET TO TRUE ZERO
* V IS SET IF NUMBER BECAME DENORMALIZED
* DURING NORMALIZATION.
* Z AND V ARE CLEARED OTHERWISE
*
* NOTE: MUCH OF THE CODE IS SHARED WITH THE 'ENORM'
* PROCEDURE. IT IS IDENTICAL TO SNORM/LNORM EXCEPT
* FOR ITS LOOP TERMINATION CONDITIONS. THEREFORE
* SNORM/LNORM PUSH A FLAG ON THE STACK THAT IS USED
* BY THE MUTUAL CODE TO DETERMINE WHICH LOOP TERMINATOR
* TO USE.
********************************************************
*
SNORM EQU * DOUBLE ENTRY FOR THIS ROUTINE
LNORM EQU *
PSHS D,Y SAVE CALLER'S REGS
CLR TYPE,X SET TYPE TO NORMALIZED
CLR ,-S FLAG = 0 = SNORM,LNORM CALL
*
MUTNRM EQU * ENORM ENTRY PT.
*
BSR TFRACT IF FRACTION = 0 THEN
IFCC EQ
MOVD #$8000,(EXP,X) SET TO ZERO
MOVA #TYZERO,(TYPE,X) CHANGE TYPE TO ZERO
ORCC #Z SET Z BIT (V=0)
BRA SNOUT EXIT
ENDIF
LDY EXP,X PUT EXPONENT IN REG FOR SPEED
LDA FRACT,X PUT MSB OF FRACTION IN REG FOR SPEED
IFTST (,S),EQ,#0 SNORM/LNORM CALL
TSTA EXIT IF ALREADY
BMI SNOUT NORMALIZED.
*
ELSE ENORM CALL
IF Y,LE,(3,S) EXIT IF ALREADY
BRA SNOUT AT ORIGINAL EXPONENT
*
ENDIF
*
ENDIF
*
SNLOOP EQU *
DECY . DEC EXPONENT
IF Y,EQ,#$8000 IF DOWN TO MIN EXPONENT THEN
STA FRACT,X RESTORE FRACCTION AND EXPONENT
STY EXP,X
MOVA #TYNNRM,(TYPE,X) CHANGE TYPE TO NOT NORMALIZED
ORCC #V SET V BIT (Z=0)
BRA SNOUT EXIT
ENDIF
LSL FRACT+8,X SHIFT FRACTION 1 BIT LEFT
ROL FRACT+7,X
ROL FRACT+6,X
ROL FRACT+5,X
ROL FRACT+4,X
ROL FRACT+3,X
ROL FRACT+2,X
ROL FRACT+1,X
ROLA
IFTST (,S),EQ,#0 IF SNORM/LNORM CALL
TSTA BRANCH IF NOT
BPL SNLOOP YET NORMALIZED
*
ELSE ENORM CALL
IF Y,GT,(3,S) BRANCH IF NOT YET
BRA SNLOOP ORIGINAL EXPONENT
*
ENDIF
*
ENDIF
STA FRACT,X RESTORE FRCT AND EXPONENT
STY EXP,X
ANDCC #$F9 CLEAR Z AND V BIT
SNOUT EQU *
LEAS 1,S CLEAN UP STACK
PULS D,Y,PC RESTORE AND RETURN
PAGE
********************************************************
*
* ENORM - NORMALIZE AN EXTENDED PRECISION NUMBER
* THAT IS IN INTERNAL FORM TO ITS ORIGINAL
* PRECISION
*
* ON ENTRY: X POINTS TO ARGUMENT ON THE STACK FRAME
* Y CONTAINS ORIGINAL EXPONENT OF THE ARG.
*
* ON EXIT: THE NUMBER POINTED TO BY X IS NORMALIZED
* TO IT'S ORIGINAL PRECISION.
* Z IS SET IF THE FRACTION WAS ZERO. ADDITIONALLY
* THE NUMBER IS SET TO A TRUE ZERO
* V IS SET IF THE NUMBER BECAME DENORMALIZED
* DURING NORMALIZATION.
*
* NOTE: MOST NUMBERS LEAVE THIS ROUTINE UNNORMALIZED.
* SINCE THE INNER PORTION OF THE LOOP OF THIS ALGORITHM
* WAS ALMOST IDENTICAL TO SNORM/LNORM THEY WERE COMBINED.
* A FLAG IS PUSHED ONTO THE STACK BEFORE THE CALL TO
* THE MUTUAL CODE TO DIFFERENTIATE THE UNSIMILAR CODE.
*
***********************************************************
*
ENORM PSHS D,Y SAVE CALLERS'S REGS
LDB #1 SET FLAG FOR
STB ,-S ENORM CALL
BRA MUTNRM GO JOIN MUTUAL NORM. CODE
*
PAGE
*
************************************************************
*
* P R E C
*
* THIS ROUTINE DETERMINES THE PRECISION OF AN ARGUMENT IN
* USER MEMORY. THE VALUE RETURNED IS AN INDEX
* DEFINED AS:
* SINGLE = 0
* DOUBLE = 2
* EXTENDED = 4
* EXTENDED ROUNDED TO SINGLE = 6
* EXTENDED ROUNDED TO DOUBLE = 8
*
* PREC KNOWS ABOUT MOV AND CMP AND WILL RETURN THE
* PROPER PRECISION INDEX.
*
* ENTRY:
* U = POINTER TO STACK FRAME
* FOR CMP B = 0 FOR ARG1; B.NE.0 FOR ARG2
* FOR MOV B = 0 FOR ARG2; B.NE.0 FOR RESULT
* FOR ALL OTHERS B IS A DON'T CARE
*
* EXIT;
* B = PRECISION INDEX
* Z = 1 IFF B = 0
* ALL REGISTERS RESTORED EXCEPT CC BITS
*
* **** MAJOR REVISIONS *****
* REVISOR DATE REASON
* JOEL BONEY 022980 ORIGINAL
* JOEL BONEY 031980 FASTER
*
*
***********************************************************
*
PREC EQU *
IFTST (FUNCT,U),GE,#0 IF NOT MIXED ARGUMENTS
LDB [PFPCB,U] GET FPCB CONTROL WORD. BITS 5-7 ARE PRECISION
LSRB POSITION PRECISION IN 4LSB
LSRB
LSRB
LSRB
ANDB #$0E PRECISION NOW 0,2,4,6 OR 8
RTS ADIOS
ELSE COMPARE OR MOVE
PSHS A
LDA TPARAM+1,U GET PRECISION BYTE FROM STACK
IFTST B,EQ,#0 IF UPPER NYBBLE THEN
ANDA #$70 POSITION IT
LSRA
LSRA
LSRA
ELSE LOWER NYBBLE
ANDA #$7 POSITION IT
LSLA
ENDIF
TFR A,B PUT RESULT IN B
PULS A,PC EXIT
ENDIF
*
*
PAGE
************************************************************
*
* S I Z E
*
* THIS ROUTINE DETERMINES THE SIZE OF AN ARGUMENT IN
* USER MEMORY. THE VALUE RETURNED IS:
* SINGLE = 4
* DOUBLE = 8
* EXTENDED = 10
*
* SIZE KNOWS ABOUT MOV AND CMP AND WILL RETURN THE
* PROPER SIZE.
*
* ENTRY:
* U = POINTER TO STACK FRAME
* FOR CMP B = 0 FOR ARG1; B.NE.0 FOR ARG2
* FOR MOV B = 0 FOR ARG2; B.NE.0 FOR RESULT
* FOR ALL OTHERS B IS A DON'T CARE
*
* EXIT;
* B = SIZE
* ALL REGISTERS RESTORED EXCEPT CC BITS
*
*
* ***** MAJOR REVISIONS *****
* REVISOR DATE REASON
* JOEL BONEY 022980 ORIGINAL
*
***********************************************************
*
SIZE EQU *
PSHS X
LEAX SIZTAB,PCR POINT TO SIZE TABLE
BSR PREC GO GET PRECISION
LSRB DIVIDE INDEX BY 2
LDB B,X CONVERT TO SIZE
PULS X,PC
*
* TABLE TO CONVERT PRECISION INDEX TO SIZE
*
SIZTAB EQU *
FCB 4,8,10,10,10
*
*